CD ROM Paradise Collection 4/CD ROM Paradise Collection 4 1995 Nov.iso/program/tjgold.zip/INSTALL.002/GOLDIO2.PAS

Pascal/Delphi Source File | 1995-07-12 | 62KB | 2,131 lines

{--------------------------------------------------------------------------}
{                Product: TechnoJock's Turbo Toolkit                       }
{                Version: GOLD                                             }
{                Build:   1.01                                             }
{                                                                          }
{                Copyright 1986-1995  TechnoJock Software, Inc.            }
{                           All Rights Reserved                            }
{                          Restricted by License                           }
{--------------------------------------------------------------------------}

                    {*********************************}
                    {**       Unit:   GOLDIO2       **}
                    {*********************************}

{+++++++++++++++++++++++++++++++} unit GOLDIO2; {++++++++++++++++++++++++++++}

{$I GOLDFLAG.INC}
{$IFNDEF GOLDIO2}
   {$DEFINE GOLDIO2}
{$ENDIF}

{++++++++++++++++++++++++++++++++} INTERFACE {+++++++++++++++++++++++++++++++}

uses DOS, CRT, GoldHard, GoldTint, GoldMisc, GoldKey, GoldFast, GoldWin,
     GoldLink, GoldStr, GoldDate, GoldIO, GoldList, GoldGrid;

type
   StringChoice = string[3];

   IO2Set = record
      ButtonWasDown:boolean;
      CheckOff:stringchoice;
      CheckOn:stringchoice;
      RadioOff: stringchoice;
      RadioOn: stringchoice;
      ScrollLeft: char;
      ScrollRight: char;
      ButtonLeft: char;
      ButtonRight: char;
{$IFNDEF NOVGACHARS}
      FancyCheckOff:stringchoice;
      FancyCheckOn:stringchoice;
      FancyRadioOff:stringchoice;
      FancyRadioOn:stringchoice;
{$ENDIF}
   end; {IO2Set}

   GroupItemPtr = ^GroupItem;
   GroupItem = record
      NextPtr: GroupItemPtr;
      StrPtr: ^string;
      MsgPtr: ^string;
      HK: word;
      Selected: ^boolean;
      X: byte;
      Y: byte;
      Active: boolean;
   end;

   GroupInfoPtr = ^GroupInfo;
   GroupInfo = record
      TotalItems: byte;
      ActiveItem: byte;
      FirstItemPtr: GroupItemPtr;
      RadioSource: ^byte;
   end;

{button}
procedure ButtonField(FieldID:integer; Face:string; Action:gAction);
procedure ButtonDefaultField(FieldID:integer; Face:string; Action:gAction);
procedure ButtonChangeSettings(FieldID:integer; Face:string; Action:gAction);
procedure ButtonDisplay(FNP:FieldSettingsPtr;Status:gStatus);
{common routine for check boxes and radio buttons}
procedure CheckRadioSetActive(FieldID,ItemNum:integer;IsActive:boolean);
{check boxes}
procedure CheckField(FieldID:integer; width,depth:byte);
procedure CheckAddItem(FieldID,ItemX,ItemY:integer; Str,Msg:string;ItemHK:word;var gResult:boolean);
{radio buttons}
procedure RadioField(FieldID:integer; width,depth:byte; var SelectedItem:byte);
procedure RadioAddItem(FieldID,ItemX,ItemY:integer; Str,Msg:string;ItemHK:word);
{list field}
procedure ListField(FieldID:integer; width,depth:byte; var SelectedItem:integer);
procedure ListAssignStrLL(FieldID:integer; var SL:StringLL);
procedure ListUpdateStrLL(FieldID:integer; var SL:StringLL);
function  ListLastKey(FieldID:integer):word;
procedure ListAddItem(FieldID:integer; Str:string);
procedure ListKwikAddItem(FieldID:integer; Str:string);
procedure ListRebuild(FieldID:integer; Str:string);
function  ListGetString(FieldID:integer; EntryNo:integer): string;
function  ListGetActivePick(FieldID:integer): integer;
{wrap or multi-column list field}
procedure WrapListField(FieldID:integer;Colwidth,ColCount,RowCount:byte;var ListDetails: ListCfg);
procedure GridListField(FieldID:integer;width,depth:byte;var ListDetails: ListCfg);
{scroll field}
procedure ScrollField(FieldID:integer; var Strvar:string;FieldL,MaxL:byte);
procedure ScrollForceCase(FieldID:integer; FCase: gCase);
{INTERNAL}
procedure DoNothing(FSP:FieldSettingsPtr);
function  SuspendOK:boolean;
procedure ScrollDisplay(FSP:FieldSettingsPtr;Status:gStatus);
function  ScrollKeyHandler(InKey:word;X,Y:byte):gAction;
procedure DisposeScrollMemory(FNP:FieldSettingsPtr);
procedure DisposeListMemory(FNP:FieldSettingsPtr);
procedure SetFieldDefaults(FieldInfo: FieldSettingsPtr);

var
   IO2Vars: IO2Set;

{+++++++++++++++++++++++++++++} IMPLEMENTATION {+++++++++++++++++++++++++++++}

                      {******************************}
                      {**  Miscellaneous Routines  **}
                      {******************************}

{ Use IOSetError from GOLDIO }

{$IFOPT F-}
   {$DEFINE FOFF}
   {$F+}
{$ENDIF}
procedure DoNothing(FSP:FieldSettingsPtr);
{}
begin
end; { DoNothing }

function SuspendOK:boolean;
{}
begin
   SuspendOK := true;
end; { Suspend }
{$IFDEF FOFF}
   {$F-}
   {$UNDEF FOFF}
{$ENDIF}

procedure SetFieldDefaults(FieldInfo: FieldSettingsPtr);
{}
begin
   with FieldInfo^ do
   begin
      FieldType := IOOther;
      DataPtr  := nil;
      DataPtrS := nil;
      DataSize := ButtonMarker;
      RefreshFieldHook := DoNothing;
      UpdateVarHook := DoNothing;
      DisposeHook := BasicDisposeHook;
   end;
end; { SetFieldDefaults }

                     {*********************}
                     {**  Button Fields  **}
                     {*********************}

procedure WriteButton(Down: boolean);
{}
var BStr: StrButton;
begin
   with ActiveForm^ do
      with ActiveFieldPtr^.FieldInfo^ do
         if Down <> IO2Vars.ButtonWasDown then
         with IOVars.Form[IOVars.CurrentForm]^ do
         begin
            BStr := IO2Vars.ButtonLeft+FieldStr+IO2Vars.ButtonRight;
            if Down then
            begin
               DrawButtonDown(X1,X2,Y2,Col[IOButtonHiHot],
                              Col[IOButtonHi],BStr);
               gotoxy(succ(WhereX),WhereY);
            end else
            begin
               DrawButton(X1,X2,Y2,Col[IOButtonHiHot],
                          Col[IOButtonHi],BStr);
               gotoxy(pred(WhereX),WhereY);
            end;
            IO2Vars.ButtonWasDown := Down;
            if (ActiveForm^.WinNum <> 0) then
               WinDrawTop;
         end;
end; { WriteButton }

function ButtonDown:boolean;
{}
var L,C,R: boolean;
    X,Y:byte;
begin
   with ActiveForm^ do
      with ActiveFieldPtr^.FieldInfo^ do
      begin
         IO2Vars.ButtonWasDown := false;
         WriteButton(true);
         repeat
            MouseStatusWin(L,C,R,X,Y);
            if L and ( (Y <> Y2) or (X < X1) or (X > X2+ord(IO2Vars.ButtonWasDown))) then
               WriteButton(false)
            else
               WriteButton(true);
         until not L;
         ButtonDown := (X >= X1) and (X <= X2+ord(IO2Vars.ButtonWasDown)) and (Y = Y2);
      end;
end; { ButtonDown }

{$IFOPT F-}
   {$DEFINE FOFF}
   {$F+}
{$ENDIF}
procedure ButtonDisplay(FNP:FieldSettingsPtr;Status:gStatus);
{}
var A,B: byte;
begin
   case Status of
      Activate,
      HiStatus: with IOVars.Form[IOVars.CurrentForm]^ do begin
         with FNP^ do begin
            DrawButton(X1,X2,Y2,Col[IOButtonHiHot],
                       Col[IOButtonHi],IO2Vars.ButtonLeft+FieldStr+IO2Vars.ButtonRight);
            GotoXY(X1+(X2 - X1) div 2,Y2);
         end;
      end;
      NormStatus,
      OffStatus: with IOVars.Form[IOVars.CurrentForm]^ do
      begin
         if (Status= OffStatus) or (FNP^.Active <> FldOn) then
         begin
            A := Col[IOButtonOff];
            B := Col[IOButtonOff];
         end else
         if FNP^.ID = DefaultButtonID then
         begin
            A := Col[IOButtonDefHot];
            B := Col[IOButtonDef];
         end else
         begin
            A := Col[IOButtonNormHot];
            B := Col[IOButtonNorm];
         end;
         with FNP^ do
               DrawButton(X1,X2,Y2,A,B,' '+FieldStr+' ')
      end;
   end; {case}
end; { ButtonDisplay }

function ButtonKeyHandler(InKey:word;X,Y:byte):gAction;
{}
begin
   ButtonKeyHandler := none;
   with ActiveForm^ do
      with ActiveFieldPtr^.FieldInfo^ do
        case Inkey of
           13: begin
              ButtonKeyHandler := gAction(OMisc);
              {animate the button press}
               WriteButton(true);
               delay(HardVars.AnimateDelay);
               WriteButton(false)
           end;
           500: if (X >= X1) and (X <= X2) and (Y = Y1) and ButtonDown then
           begin
              ButtonKeyHandler := gAction(OMisc);
              WriteButton(false);
           end;
        end; {case}
end; { ButtonKeyHandler }

function ButtonHotKeyHandler(FNP:FieldSettingsPtr;var Key:word;var Act:gAction):boolean;
{}
var Selected: boolean;
begin
   if FNP <> nil then with FNP^ do
      Selected := (Key <> 0) and (Key = HotKey) and (Active = FldOn)
   else
      Selected := false;
   if Selected then
   begin
      Key := 0;
      Act := gAction(FNP^.OMisc);
   end;
   ButtonHotKeyHandler := Selected;
end; { ButtonHotKeyHandler }

{$IFDEF FOFF}
   {$F-}
   {$UNDEF FOFF}
{$ENDIF}

procedure ButtonChangeSettings(FieldID:integer; Face:string; Action:gAction);
{}
var FNP: FieldNodePtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
      with FNP^.FieldInfo^ do
      begin
         if FieldType = IOOther then
         begin
            OMisc := ord(Action);
            FieldStr    := Face;
            FieldLen    := length(strip('A',HiMarker,FieldStr));
            X2          := X1 + succ(FieldLen);
         end;
      end;
end; { ButtonChangeSettings }

procedure ButtonField(FieldID:integer; Face:string; Action:gAction);
{}
var FNP: FieldNodePtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
      with FNP^.FieldInfo^ do
      begin
         SetFieldDefaults(FNP^.FieldInfo);
         OMisc := ord(Action);
         ProcesskeyHook := ButtonkeyHandler;
         SuspendHook := SuspendOK;
         DisplayHook := ButtonDisplay;
         HotKeyHook := ButtonHotKeyHandler;
         FieldStr    := Face;
         FieldFmt    := '';
         FieldLen    := length(strip('A',HiMarker,FieldStr));
         X2          := X1 + succ(FieldLen);
         UsesEnter := true;
      end;
end; { ButtonField }

procedure ButtonDefaultField(FieldID:integer; Face:string; Action:gAction);
{}
begin
   ButtonField(FieldID,Face,Action);
   ActiveForm^.DefaultButtonID := FieldID;
end; { ButtonDefaultField }


                      {*****************************}
                      {**  Common Group Routines  **}
                      {*****************************}

function GItemPtr(FSP:FieldSettingsPtr;ItemNum:byte): GroupItemPtr;
{}
var GIP: GroupItemPtr;
    Counter: integer;
    DP: GroupInfoPtr;
begin
   if (FSP <> nil) and (ItemNum > 0) then
      with FSP^ do
      begin
         DP := DataPtr;
         GIP := DP^.FirstItemPtr;
         Counter := 1;
         while (GIP <> nil) and (Counter < ItemNum) do
         begin
            GIP := GIP^.NextPtr;
            inc(Counter);
         end;
         GItemPtr := GIP;
      end
   else
      GItemPtr := nil;
end; { GItemPtr }

function GroupItemID(X,Y:byte):byte;
{}
var IP: GroupInfoPtr;
    GIP: GroupItemPtr;
    Finished: boolean;
    Counter: byte;
begin
   IP := ActiveForm^.ActiveFieldPtr^.FieldInfo^.DataPtr; {phew}
   GIP := GItemPtr(ActiveForm^.ActiveFieldPtr^.FieldInfo,1);
   Finished := false;
   Counter := 1;
   repeat
      if  (GIP <> nil)
      and (X >= ActiveForm^.ActiveFieldPtr^.FieldInfo^.X1 + pred(GIP^.X))
      and (X <= ActiveForm^.ActiveFieldPtr^.FieldInfo^.X1 + GIP^.X + length(GIP^.StrPtr^) + 3)
      and (Y = ActiveForm^.ActiveFieldPtr^.FieldInfo^.Y1 + pred(GIP^.Y))
      and (GIP^.Active) then
         Finished := true
      else
      if (GIP <> nil) then
      begin
        GIP := GIP^.NextPtr;
        inc(Counter);
      end;
   until (Finished) or (GIP=nil);
   if Finished then
      GroupItemID := Counter
   else
      GroupItemID := 0;
end; { GroupItemID }

procedure WriteGroupItem(FSP:FieldSettingsPtr;ItemNum:byte; Status:gStatus; Str:String);
{}
var GP:GroupItemPtr;
    A,AHot: byte;
    DP: GroupInfoPtr;
begin
   GP := GItemPtr(FSP,ItemNum);
   if GP <> nil then
      with GP^ do
      begin
         with IOVars.Form[IOVars.CurrentForm]^ do
            if FSP^.Active <> FldOn then {whole field is off}
            begin
               A := Col[IOEditOff];
               AHot := Col[IOEditOff];
            end else
            begin
            case Status of
               Activate,HiStatus: begin
                  DP := FSP^.DataPtr;
                  if ItemNum = DP^.ActiveItem then
                  begin
                     A := Col[IOChoiceHi];
                     AHot:= Col[IOChoiceHiHot];
                     GotoXY(FSP^.X1+GP^.X+1,pred(FSP^.Y1)+GP^.Y);
                  end else
                  begin
                     A := Col[IOChoiceNorm];
                     AHot := Col[IOChoiceNormHot];
                  end;
                  RemoveMessage(FSP);
                  if MsgPtr <> nil then
                     DisplayMessage(FSP,MsgPtr^);
               end;
               NormStatus: begin
                  if Active then
                  begin
                     A := Col[IOChoiceNorm];
                     AHot := Col[IOChoiceNormHot];
                  end else
                  begin
                     A := Col[IOChoiceOff];
                     AHot := Col[IOChoiceOff];
                  end;
               end;
               OffStatus: begin
                  A := Col[IOChoiceOff];
                  AHot := Col[IOChoiceOff];
               end;
            end;
         end;
         with FSP^ do
           WriteHi(pred(X1)+GP^.X,pred(Y1)+GP^.Y,
                    AHot,A,Str);
      end;
end; { WriteGroupItem }

procedure GroupAddItem(FieldID,ItemX,ItemY:integer; Str,Msg:string;ItemHK:word);
{}
var FNP: FieldNodePtr;
    GrpPtr: GroupItemPtr;
    GrpInfoPtr: GroupInfoPtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
      with FNP^.FieldInfo^ do
      begin
         if GoldMaxAvail < +sizeof(GroupInfo) + sizeof(GroupItem) + succ(length(Str)) then
            IOSetError(1008);
         if (DataPtr = nil) then
         begin
            DataSize := -1;
            getmem(DataPtr,sizeof(GroupInfo));
            GrpInfoPtr := DataPtr;
            GrpInfoPtr^.TotalItems := 0;
            GrpInfoPtr^.ActiveItem := 0;
            getmem(GrpInfoPtr^.FirstItemPtr,sizeof(GrpInfoPtr^.FirstItemPtr^));
            GrpPtr := GrpInfoPtr^.FirstItemPtr;
         end else
         begin
            GrpInfoPtr := DataPtr;
            GrpPtr := GrpInfoPtr^.FirstItemPtr;
            while GrpPtr^.NextPtr <> nil do
               GrpPtr := GrpPtr^.NextPtr;
            getmem(GrpPtr^.NextPtr,sizeof(groupItem));
            GrpPtr := GrpPtr^.NextPtr;
         end;
         with GrpPtr^ do
         begin
            NextPtr := nil;
            if Str = '' then
               StrPtr := nil
            else
            begin
               getmem(StrPtr,succ(length(Str)));
               move(Str[0],StrPtr^,succ(length(Str)));
            end;
            if Msg = '' then
               MsgPtr := nil
            else
            begin
               getmem(MsgPtr,succ(length(Msg)));
               move(Msg[0],MsgPtr^,succ(length(Msg)));
            end;
            HK := ItemHK;
            X := ItemX;
            Y := ItemY;
            Active := true;
            with GrpInfoPtr^ do
            begin
               inc(TotalItems);
               if ActiveItem = 0 then
                  ActiveItem := TotalItems;
            end;
         end;
      end;
end; { GroupAddItem }

{$IFOPT F-}
   {$DEFINE FOFF}
   {$F+}
{$ENDIF}
procedure DisposeGroupMemory(FNP:FieldSettingsPtr);
{Disposes of heap memory allocated by group add item}
var GrpPtr1,GrpPtr2: GroupItemPtr;
    GrpInfoPtr: GroupInfoPtr;
begin
   if (FNP^.DataPtr <> nil) then
   begin
      GrpPtr2 := GroupInfoPtr(FNP^.DataPtr)^.FirstItemPtr;
      while GrpPtr2 <> nil do
      begin
         GrpPtr1 := GrpPtr2;
         GrpPtr2 := GrpPtr1^.NextPtr;
         if GrpPtr1^.StrPtr <> nil then
            freemem(GrpPtr1^.StrPtr,byte(succ(GrpPtr1^.StrPtr^[0])));
         if GrpPtr1^.MsgPtr <> nil then
            freemem(GrpPtr1^.MsgPtr,byte(succ(GrpPtr1^.MsgPtr^[0])));
         freemem(GrpPtr1,sizeof(GrpPtr1^));
      end;
      freemem(FNP^.DataPtr,sizeof(GroupInfo));
   end;
end; { DisposeGroupMemory }
{$IFDEF FOFF}
   {$F-}
   {$UNDEF FOFF}
{$ENDIF}

function GroupHotKeyEngine(FNP:FieldSettingsPtr;var Key:word):byte;
{}
var GIP: GroupItemPtr;
    Selected:boolean;
    ItemID: byte;
begin
   Selected := false;
   ItemID := 0;
   if (FNP <> nil) and (Key <> 0) and (FNP^.Active = FldOn) then with FNP^ do
   begin
      GIP := GroupInfoPtr(DataPtr)^.FirstItemPtr;
      while (GIP <> nil) and not Selected do
      begin
         inc(ItemID);
         Selected := (GIP^.HK = Key) and (GIP^.Active);
         if not Selected then
            GIP := GIP^.NextPtr;
      end;
   end;
   if GIP = nil then
      GroupHotKeyEngine := 0
   else
      GroupHotKeyEngine := ItemID;
end; { GroupHotKeyEngine }

                      {***********************}
                      {**  Check Box Field  **}
                      {***********************}

procedure WriteCheckItem(FSP:FieldSettingsPtr;ItemNum:byte; Status:gStatus);
{}
var GP:GroupItemPtr;
    Str: StrScreen;
    SC: stringchoice;
begin
   GP := GItemPtr(FSP,ItemNum);
   if GP <> nil then
      with GP^ do
      begin
{$IFNDEF NOVGACHARS}
         if FastVars.CustomCharsActive then
         begin
            if Selected^ then
               SC := IO2Vars.FancyCheckOn
            else
               SC := IO2Vars.FancyCheckOff;
         end else
         begin
            if Selected^ then
               SC := IO2Vars.CheckOn
            else
               SC := IO2Vars.CheckOff;
         end;
{$ELSE}
         if Selected^ then
            SC := CheckOn
         else
            SC := CheckOff;
{$ENDIF}
         WriteGroupItem(FSP,ItemNum,Status,' '+SC+' '+StrPtr^);
     end;
end; { WriteCheckItem }

procedure WriteAllCheckItems(FSP:FieldSettingsPtr;Status:gStatus);
{}
var I: integer;
    GIP: GroupInfoPtr;
begin
   GIP := FSP^.DataPtr;
   for I := 1 to GIP^.TotalItems do
       WriteCheckItem(FSP,I,Status);
end; { WriteAllCheckItems }

procedure CheckChangeActiveState(FSP:FieldSettingsPtr);
{}
var IP: GroupInfoPtr;
    GIP: GroupItemPtr;
begin
   IP := FSP^.DataPtr;
   GIP := GItemPtr(FSP,IP^.ActiveItem);
   GIP^.Selected^ := not GIP^.Selected^;
   WriteCheckItem(FSP,IP^.ActiveItem,HiStatus);
end; { CheckChangeActiveState }

procedure CheckScrollDown;
{}
var IP: GroupInfoPtr;
    GIP: GroupItemPtr;
begin
   with ActiveForm^.ActiveFieldPtr^ do
   begin
      IP := FieldInfo^.DataPtr;
      if IP^.ActiveItem <> 0 then
      begin
         GIP := GItemPtr(FieldInfo,IP^.ActiveItem);
         WriteCheckItem(FieldInfo,IP^.ActiveItem,NormStatus);
         repeat
            if IP^.ActiveItem < IP^.TotalItems then
               inc(IP^.ActiveItem)
            else
               IP^.ActiveItem := 1;
            GIP := GItemPtr(FieldInfo,IP^.ActiveItem);
         until GIP^.Active = true;
         WriteCheckItem(FieldInfo,IP^.ActiveItem,NormStatus);
      end;
   end;
end; { CheckScrollDown }

procedure CheckScrollUp;
{}
var IP: GroupInfoPtr;
    GIP: GroupItemPtr;
begin
   with ActiveForm^.ActiveFieldPtr^ do
   begin
      IP := FieldInfo^.DataPtr;
      if IP^.ActiveItem <> 0 then
      begin
         GIP := GItemPtr(FieldInfo,IP^.ActiveItem);
         WriteCheckItem(FieldInfo,IP^.ActiveItem,NormStatus);
         repeat
            if IP^.ActiveItem > 1 then
               dec(IP^.ActiveItem)
            else
               IP^.ActiveItem := IP^.TotalItems;
            GIP := GItemPtr(FieldInfo,IP^.ActiveItem);
         until GIP^.Active = true;
         WriteCheckItem(FieldInfo,IP^.ActiveItem,NormStatus);
      end;
   end;
end; { CheckScrollUp }

procedure CheckMouseDown(X,Y:byte);
{Called when the mouse button is pressed down}
var TargetField: byte;
    IP: GroupInfoPtr;
    L,M,R: boolean;
    XM,YM: byte;
    CursorVisible: boolean;
begin
   TargetField := GroupItemID(X,Y);
   if TargetField <> 0 then
   begin
      IP := ActiveForm^.ActiveFieldPtr^.FieldInfo^.DataPtr;
      if IP^.ActiveItem <> TargetField then
      begin
         WriteCheckItem(ActiveForm^.ActiveFieldPtr^.FieldInfo,IP^.ActiveItem,NormStatus);
         IP^.ActiveItem := TargetField;
         WriteCheckItem(ActiveForm^.ActiveFieldPtr^.FieldInfo,IP^.ActiveItem,HiStatus);
      end;
      CursorVisible := true;
      repeat
         MouseStatusWin(L,M,R,XM,YM);
         if GroupItemID(XM,YM) = TargetField then
         begin
            if not CursorVisible then
            begin
               CursorOn;
               CursorVisible := true;
            end;
         end else
         begin
           if CursorVisible then
           begin
              CursorOff;
              CursorVisible := false;
           end;
         end;
      until not L;
      CursorOn;
      MouseRelease; {clear the mouse buffers}
      if GroupItemID(XM,YM) = TargetField then
         CheckChangeActiveState(ActiveForm^.ActiveFieldPtr^.FieldInfo);
   end else
      MouseRelease;
end; { CheckMouseDown }

procedure CheckFocusOnActive;
{Makes sure that the item with focus is actually active, i.e. enabled}
var IP: GroupInfoPtr;
    GIP: GroupItemPtr;
    FocusID: integer;
begin
   with ActiveForm^.ActiveFieldPtr^ do
   begin
      IP := FieldInfo^.DataPtr;
      if IP^.ActiveItem <> 0 then
      begin
         GIP := GItemPtr(FieldInfo,IP^.ActiveItem);
         FocusID := IP^.ActiveItem;
         if GIP^.Active = false then
         begin
            repeat
               if IP^.ActiveItem < IP^.TotalItems then
                  inc(IP^.ActiveItem)
               else
                  IP^.ActiveItem := 1;
               GIP := GItemPtr(FieldInfo,IP^.ActiveItem);
            until (GIP^.Active) or (FocusID = IP^.ActiveItem);
            if not GIP^.Active then
               IP^.ActiveItem := 0;
         end;
      end;
   end;
end; { CheckFocusOnActive }

{$IFOPT F-}
   {$DEFINE FOFF}
   {$F+}
{$ENDIF}
procedure CheckDisplay(FSP:FieldSettingsPtr;Status:gStatus);
{}
var GIP: GroupInfoPtr;
begin
   with IOVars.Form[IOVars.CurrentForm]^ do
   case Status of
      Activate,
      HiStatus: begin
         CheckFocusOnActive;
         with FSP^ do begin
             GIP := DataPtr;
             WriteCheckItem(FSP,GIP^.ActiveItem,HiStatus);
             CursorOn;
         end;
      end;
      OffStatus,
      NormStatus: begin
         with FSP^ do
         begin
            if Active = FldOn then
               PartClear(X1,Y1,X2,Y2,Col[IOChoiceNorm],' ')
            else
               PartClear(X1,Y1,X2,Y2,Col[IOEditOff],' ');
            WriteAllCheckItems(FSP,Status);
         end;
      end;
   end; {case}
end; { CheckDisplay }

function CheckKeyHandler(InKey:word;X,Y:byte):gAction;
{}
begin
   CheckKeyHandler := none;
   with ActiveForm^ do
      with ActiveFieldPtr^.FieldInfo^ do
        case Inkey of
           32: begin
                  CheckChangeActiveState(ActiveFieldPtr^.FieldInfo);
               end;
          500: begin
                  CheckMouseDown(X,Y);
               end;
      328,331: begin
                  CheckScrollUp;
               end;
      333,336: begin
                  CheckScrollDown;
               end;
        end; {case}
end; { CheckKeyHandler }

function CheckHotkeyHandler(FSP:FieldSettingsPtr;var Key:word;var Act:gAction): boolean;
{}
var ItemID: byte;
    IP: GroupInfoPtr;
begin
   with FSP^ do
   begin
      if (Key <> 0) and (Key = HotKey) and (Active = FldOn)
      and (IOVars.Form[IOVars.CurrentForm]^.ActiveFieldPtr^.FieldInfo <> FSP) then
      begin
         Key := 0;  {absorb the key}
         CheckHotkeyHandler := true;
      end
      else
      begin
         ItemID := GroupHotkeyEngine(FSP,Key);
         if ItemID <> 0 then   {choice hotkey pressed}
         begin
            IP :=  FSP^.DataPtr;
            WriteCheckItem(FSP,IP^.ActiveItem,NormStatus);
            IP^.ActiveItem := ItemID;
            CheckChangeActiveState(FSP);
            CheckHotkeyHandler := true;
         end else
            CheckHotkeyHandler := false;
      end;
   end;
end; { CheckHotkeyHandler }

{$IFDEF FOFF}
   {$F-}
   {$UNDEF FOFF}
{$ENDIF}

procedure CheckField(FieldID:integer; width,depth:byte);
{}
var FNP: FieldNodePtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
      with FNP^.FieldInfo^ do
      begin
         SetFieldDefaults(FNP^.FieldInfo);
         X2 := X1 + pred(width);
         Y2 := Y1 + pred(depth);
         ProcesskeyHook := CheckKeyHandler;
         SuspendHook := SuspendOK;
         DisplayHook := CheckDisplay;
         HotKeyHook := CheckHotKeyHandler;
         DisposeHook := DisposeGroupMemory;
         FieldStr    := '';
         FieldFmt    := '';
         FieldLen    := 0;
         OMisc       := CheckFld;
         UsesCursors := true;
      end;
end; { CheckField }

procedure CheckAddItem(FieldID,ItemX,ItemY:integer; Str,Msg:string;ItemHK:word;var gResult:boolean);
{}
var FNP: FieldNodePtr;
    GrpPtr: GroupItemPtr;
    GrpInfoPtr: GroupInfoPtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
      with FNP^.FieldInfo^ do
      begin
         if OMisc <> CheckFld then
            IOSetError(1007);
         GroupAddItem(FieldID,ItemX,ItemY,Str,Msg,ItemHK);
         GrpInfoPtr := FNP^.FieldInfo^.DataPtr;
         GRPPtr := GItemPtr(FNP^.FieldInfo,GrpInfoPtr^.TotalItems);
         GrpPtr^.Selected := @gResult;
      end;
end; { CheckAddItem }

procedure CheckRadioSetActive(FieldID,ItemNum:integer;IsActive:boolean);
{}
var FNP: FieldNodePtr;
    GIP: GroupItemPtr;
    IP: GroupInfoPtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
      with FNP^.FieldInfo^ do
         if OMisc in [CheckFld,RadioFld] then
         begin
            IP := FNP^.FieldInfo^.DataPtr;
            GIP := GItemPtr(FNP^.FieldInfo,ItemNum);
            if GIP <> nil then
               GIP^.Active := IsActive;
         end;
end; { CheckRadioSetActive }

                     {*********************}
                     {**  RADIO BUTTONS  **}
                     {*********************}

procedure WriteRadioItem(FSP:FieldSettingsPtr;ItemNum:byte; Status:gStatus);
{}
var GP:GroupItemPtr;
    Str: StrScreen;
    SC: stringchoice;
begin
   GP := GItemPtr(FSP,ItemNum);
   if GP <> nil then
      with GP^ do
      begin
{$IFNDEF NOVGACHARS}
         if FastVars.CustomCharsActive then
         begin
            if byte(FSP^.SourcePtr^) = ItemNum then
               SC := IO2Vars.FancyRadioOn
            else
               SC := IO2Vars.FancyRadioOff;
         end else
         begin
            if byte(FSP^.SourcePtr^) = ItemNum then
               SC := IO2Vars.RadioOn
            else
               SC := IO2Vars.RadioOff;
         end;
{$ELSE}
         if byte(FSP^.SourcePtr^) = ItemNum then
            SC := RadioOn
         else
            SC := RadioOff;
{$ENDIF}
         WriteGroupItem(FSP,ItemNum,Status,' '+SC+' '+StrPtr^);
      end;
end; { WriteRadioItem }

procedure WriteAllRadioItems(FSP:FieldSettingsPtr;Status:gStatus);
{}
var I: integer;
    GIP: GroupInfoPtr;
begin
   GIP := FSP^.DataPtr;
   for I := 1 to GIP^.TotalItems do
       WriteRadioItem(FSP,I,Status);
end; { WriteAllRadioItems }

procedure RadioChangeSelectedOption(FSP:FieldSettingsPtr; NewSelection:byte);
{}
var
   OwnerByte: ^byte;
   GIP: GroupInfoPtr;
   ClearAll:boolean;
begin
   with FSP^ do
   begin
      GIP := DataPtr;
      OwnerByte := SourcePtr;
      ClearAll := OwnerByte^ <> GIP^.ActiveItem;
      OwnerByte^ := NewSelection;
      if ClearAll then
         WriteAllRadioItems(FSP,NormStatus)
      else
         WriteRadioItem(FSP,GIP^.ActiveItem,NormStatus);
      GIP^.ActiveItem := NewSelection;
      WriteRadioItem(FSP,NewSelection,NormStatus);
   end;
end; { RadioChangeSelectedOption }

procedure RadioScrollDown;
{}
var IP: GroupInfoPtr;
    GIP: GroupItemPtr;
    NewSelection: byte;
begin
   with ActiveForm^.ActiveFieldPtr^ do
   begin
      IP := FieldInfo^.DataPtr;
      if IP^.ActiveItem <> 0 then
      begin
         GIP := GItemPtr(FieldInfo,IP^.ActiveItem);
         NewSelection := IP^.ActiveItem;
         repeat
            if NewSelection < IP^.TotalItems then
               inc(NewSelection)
            else
               NewSelection := 1;
            GIP := GItemPtr(FieldInfo,NewSelection);
         until GIP^.Active = true;
         RadioChangeSelectedOption(ActiveForm^.ActiveFieldPtr^.FieldInfo,NewSelection);
      end;
   end;
end; { RadioScrollDown }

procedure RadioScrollUp;
{}
var IP: GroupInfoPtr;
    GIP: GroupItemPtr;
    NewSelection : byte;
begin
   with ActiveForm^.ActiveFieldPtr^ do
   begin
      IP := FieldInfo^.DataPtr;
      if IP^.ActiveItem <> 0 then
      begin
         GIP := GItemPtr(FieldInfo,IP^.ActiveItem);
         NewSelection := IP^.ActiveItem;
         repeat
            if NewSelection > 1 then
               dec(NewSelection)
            else
               NewSelection := IP^.TotalItems;
            GIP := GItemPtr(FieldInfo,NewSelection);
         until GIP^.Active = true;
         RadioChangeSelectedOption(ActiveForm^.ActiveFieldPtr^.FieldInfo,NewSelection);
      end;
   end;
end; { RadioScrollUp }

procedure RadioSelectActiveItem(FSP:FieldSettingsPtr);
{}
var OwnerByte: ^byte;
    GIP: GroupInfoPtr;
begin
   with FSP^ do
   begin
      GIP := DataPtr;
      OwnerByte := SourcePtr;
      if OwnerByte^ <> GIP^.ActiveItem then
         RadioChangeSelectedOption(FSP,GIP^.ActiveItem);
   end;
end; { RadioSelectActiveItem }

procedure RadioCheckActiveIsSelected(FSP:FieldSettingsPtr);
{Called when field is activated to ensure that the selected item is the
 active item}
var OwnerByte: ^byte;
    GIP: GroupInfoPtr;
begin
   with FSP^ do
   begin
      GIP := DataPtr;
      OwnerByte := SourcePtr;
      if OwnerByte^ <> GIP^.ActiveItem then
      begin
         GIP^.ActiveItem := OwnerByte^;
         WriteAllRadioItems(FSP,HiStatus);
      end;
   end;
end; { RadioCheckActiveIsSelected }

procedure RadioMouseDown(X,Y:byte);
{Called when the mouse button is pressed down}
var TargetField: byte;
    IP: GroupInfoPtr;
    L,M,R: boolean;
    XM,YM: byte;
    CursorVisible: boolean;
begin
   TargetField := GroupItemID(X,Y);
   if TargetField <> 0 then
   begin
      IP := ActiveForm^.ActiveFieldPtr^.FieldInfo^.DataPtr;
      if IP^.ActiveItem <> TargetField then
      begin
         WriteRadioItem(ActiveForm^.ActiveFieldPtr^.FieldInfo,IP^.ActiveItem,NormStatus);
         IP^.ActiveItem := TargetField;
         WriteRadioItem(ActiveForm^.ActiveFieldPtr^.FieldInfo,IP^.ActiveItem,HiStatus);
      end;
      CursorVisible := true;
      repeat
         MouseStatusWin(L,M,R,XM,YM);
         if GroupItemID(XM,YM) = TargetField then
         begin
            if not CursorVisible then
            begin
               CursorOn;
               CursorVisible := true;
            end;
         end else
         begin
           if CursorVisible then
           begin
              CursorOff;
              CursorVisible := false;
           end;
         end;
      until not L;
      CursorOn;
      MouseRelease; {clease the mouse buffers}
      if GroupItemID(XM,YM) = TargetField then
         RadioChangeSelectedOption(ActiveForm^.ActiveFieldPtr^.FieldInfo,TargetField);
   end else
      MouseRelease;
end; { RadioMouseDown }

{$IFOPT F-}
   {$DEFINE FOFF}
   {$F+}
{$ENDIF}
procedure RadioDisplay(FSP:FieldSettingsPtr;Status:gStatus);
{}
var GIP: GroupInfoPtr;
begin
   with IOVars.Form[IOVars.CurrentForm]^ do
   case Status of
      Activate,
      HiStatus: begin
         with FSP^ do begin
             if Status = Activate then
                RadioCheckActiveIsSelected(FSP);
             CheckFocusOnActive;
             GIP := DataPtr;
             WriteRadioItem(FSP,GIP^.ActiveItem,HiStatus);
             CursorOn;
         end;
      end;
      OffStatus,
      NormStatus: begin
         with FSP^ do
         begin
            if Active = FldOn then
               PartClear(X1,Y1,X2,Y2,Col[IOChoiceNorm],' ')
            else
               PartClear(X1,Y1,X2,Y2,Col[IOEditOff],' ');
            WriteAllRadioItems(FSP,Status);
         end;
      end;
   end; {case}
end; { RadioDisplay }

function RadioHotkeyHandler(FSP:FieldSettingsPtr;var Key:word;var Act:gAction): boolean;
{}
var ItemID: byte;
    IP: GroupInfoPtr;
begin
   with FSP^ do
   begin
      if (Key <> 0) and (Key = HotKey) and (Active = FldOn)
      and (IOVars.Form[IOVars.CurrentForm]^.ActiveFieldPtr^.FieldInfo <> FSP) then
      begin
         Key := 0;  {absorb the key}
         RadioHotkeyHandler := true;
      end
      else
      begin
         ItemID := GroupHotkeyEngine(FSP,Key);
         if ItemID <> 0 then   {choice hotkey pressed}
         begin
            IP :=  FSP^.DataPtr;
            if IP^.ActiveItem <> ItemID then
            begin
               IP^.ActiveItem := ItemID;
               RadioSelectActiveItem(FSP);
            end;
            RadioHotkeyHandler := true;
         end else
            RadioHotkeyHandler := false;
      end;
   end;
end; { RadioHotkeyHandler }

function RadioKeyHandler(InKey:word;X,Y:byte):gAction;
{}
var Dummy: gAction;
begin
   RadioKeyHandler := none;
   with ActiveForm^ do
      with ActiveFieldPtr^.FieldInfo^ do
        case Inkey of
           32: begin
              RadioSelectActiveItem(ActiveForm^.ActiveFieldPtr^.FieldInfo);
           end;
           500: begin
              RadioMouseDown(X,Y);
           end;
           328,331: begin
              RadioScrollUp;
           end;
           333,336: begin
              RadioScrollDown;
           end;
        end; {case}
end; { RadioKeyHandler }

{$IFDEF FOFF}
   {$F-}
   {$UNDEF FOFF}
{$ENDIF}

procedure RadioField(FieldID:integer; width,depth:byte; var SelectedItem:byte);
{}
var FNP: FieldNodePtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
      with FNP^.FieldInfo^ do
      begin
         SetFieldDefaults(FNP^.FieldInfo);
         X2 := X1 + pred(width);
         Y2 := Y1 + pred(depth);
         ProcesskeyHook := RadioKeyHandler;
         SuspendHook := SuspendOK;
         DisplayHook := RadioDisplay;
         HotKeyHook := RadioHotKeyHandler;
         DisposeHook := DisposeGroupMemory;
         FieldStr    := '';
         FieldFmt    := '';
         FieldLen    := 0;
         OMisc       := RadioFld;
         UsesCursors := true;
         SourcePtr := @SelectedItem;
      end;
end; { RadioField }

procedure RadioAddItem(FieldID,ItemX,ItemY:integer; Str,Msg:string;ItemHK:word);
{}
var FNP: FieldNodePtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
      with FNP^.FieldInfo^ do
      begin
         if OMisc <> RadioFld then
            IOSetError(1007);
         GroupAddItem(FieldID,ItemX,ItemY,Str,Msg,ItemHK);
      end;
end; { RadioAddItem }

                     {*****************************}
                     {**  Common List Functions  **}
                     {*****************************}

{$IFOPT F-}
   {$DEFINE FOFF}
   {$F+}
{$ENDIF}
procedure DisposeListMemory(FNP:FieldSettingsPtr);
{Disposes of heap memory allocated by group add item}
begin
   if (FNP^.DataPtr <> nil) then
   begin
      if ListCfg(FNP^.DataPtr^).IODispose then
      begin
         StrLLDestroy(StringLLPtr(ListCfg(FNP^.DataPtr^).DataSource)^);
         freemem(ListCfg(FNP^.DataPtr^).DataSource,sizeof(StringLL));
      end;
      freemem(FNP^.DataPtr,sizeof(ListCfg));
      FNP^.DataPtr := nil;
   end;
end; { DisposeListMemory }
{$IFDEF FOFF}
   {$F-}
   {$UNDEF FOFF}
{$ENDIF}

procedure ListAddItem(FieldID:integer; Str:string);
{}
var
   FNP: FieldNodePtr;
   SLP: StringLLPtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
      with FNP^.FieldInfo^ do
      begin
         if not ((OMisc = ListFld) or (OMisc = ScrollFld)) then
            IOSetError(1007);
         if DataPtr = nil then
         begin
            if GoldMaxAvail < sizeof(SLP^)+sizeof(ListCfg) then
               IOSetError(1008);
            getmem(DataPtr,sizeof(ListCfg));
            initlistcfg(ListCfg(DataPtr^));
            ListCfg(DataPtr^).X1 := X1;
            ListCfg(DataPtr^).Y1 := Y1;
            ListCfg(DataPtr^).X2 := X2;
            ListCfg(DataPtr^).Y2 := Y2;
            with ListCfg(DataPtr^) do
            begin
               getmem(DataSource,sizeof(StringLL));
               SLP := DataSource;
               StrLLInit(SLP^);
               GetStr := SLGetStr;
               InWindow := (ActiveForm^.WinNum <> 0);
               ActiveNode := 1;
               TopNode := 1;
               Col[ListHi1] := IOVars.Form[IOVars.CurrentForm]^.Col[IOListHi];
               Col[ListHi2] := IOVars.Form[IOVars.CurrentForm]^.Col[IOListHiHot];
               Col[ListHiInactive] := IOVars.Form[IOVars.CurrentForm]^.Col[IOListHiInactive];
               Col[ListNorm1] := IOVars.Form[IOVars.CurrentForm]^.Col[IOListNorm];
               Col[ListNorm2] := IOVars.Form[IOVars.CurrentForm]^.Col[IOListNormHot];
               Col[ListOff] := IOVars.Form[IOVars.CurrentForm]^.Col[IOListOff];
               Col[ListScrollBarHi] := IOVars.Form[IOVars.CurrentForm]^.Col[IOListScroll];
               Col[ListScrollBarNorm] := IOVars.Form[IOVars.CurrentForm]^.Col[IOListScroll];
            end;
         end else
            SLP := ListCfg(DataPtr^).DataSource;
         if StrLLAdd(SLP^,Str) <> 0 then
            IOSetError(1008);
         inc(ListCfg(FNP^.FieldInfo^.DataPtr^).TotalNodes)
      end;
end; { ListAddItem }

procedure ListKwikAddItem(FieldID:integer; Str:string);
{Allows multiple items to be added in a single string with each
 item being separated using the StrVars.LineBreak character}
var P : byte;
begin
   P := 1;
   while P <> 0 do
   begin
      P := pos(StrVars.LineBreak,Str);
      if P = 0 then
         ListAddItem(FieldID,Str)
      else
      begin
         ListAddItem(FieldID,copy(Str,1,pred(P)));
         delete(Str,1,P);
      end;
   end;
end; { ListKwikAddItem }

procedure ListRebuild(FieldID:integer; Str:string);
{Erases the existing fields and adds first new item}
var FNP: FieldNodePtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
   begin
      DisposeListMemory(FNP^.FieldInfo);
      ListKwikAddItem(FieldID,Str);
   end;
end; {ListRebuild}

procedure ListUpdateStrLL(FieldID:integer; var SL:StringLL);
{}
var FNP: FieldNodePtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
      with ListCfg(FNP^.FieldInfo^.DataPtr^) do
      begin
         TotalNodes := SL.TotalNodes;
         ActiveNode := SL.ActiveNode;
         TopNode := SL.TopNode;
      end;
      with FNP^.FieldInfo^ do
         integer(SourcePtr^) := ListCfg(DataPtr^).ActiveNode;
end; { ListUpdateStrLL }

procedure ListAssignStrLL(FieldID:integer; var SL:StringLL);
{}
var FNP: FieldNodePtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
      with FNP^.FieldInfo^ do
      begin
         if OMisc <> ListFld then
            IOSetError(1007);
         if DataPtr = nil then {no list already assigned}
            ListAddItem(FieldID,'Dummy');
         if ListCfg(DataPtr^).DataSource <> nil then
            StrLLDestroy(StringLLPtr(ListCfg(DataPtr^).DataSource)^);
         freemem(ListCfg(DataPtr^).DataSource,sizeof(StringLL));
         with ListCfg(DataPtr^) do
         begin
             DataSource := @SL;
             TotalNodes := SL.TotalNodes;
             ActiveNode := SL.ActiveNode;
             TopNode := SL.TopNode;
             {set flag so list is not disposed by DisposeFields}
             IODispose := false;
         end;
     end;
end; { ListAssignStrLL }

                     {**********************}
                     {**  List Functions  **}
                     {**********************}
function ListGetString(FieldID:integer; EntryNo:integer): string;
{Returns the highlighted string -- an EntryNo of zero returns the active node}
var FNP: FieldNodePtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
   begin
      with ListCfg(FNP^.FieldInfo^.DataPtr^) do
      begin
         if EntryNo = 0 then
            EntryNo := ActiveNode;
         ListGetString := GetStr(DataSource,EntryNo,0,0);
      end;
   end
   else
      ListGetString := '';
end; { ListGetString }

function ListGetActivePick(FieldID:integer): integer;
{}
var FNP: FieldNodePtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
      ListGetActivePick := ListCfg(FNP^.FieldInfo^.DataPtr^).ActiveNode
   else
      ListGetActivePick := 0;
end; { ListGetActivePick }

{$IFOPT F-}
   {$DEFINE FOFF}
   {$F+}
{$ENDIF}

procedure ListDisplay(FSP:FieldSettingsPtr;Status:gStatus);
{}
begin
   GListRefresh(ListCfg(FSP^.DataPtr^),Status);
end; { ListDisplay }

function ListKeyHandler(InKey:word;X,Y:byte):gAction;
{}
begin
   ListKeyHandler := none;
   with ActiveForm^.ActiveFieldPtr^.FieldInfo^ do
   begin
      GListProcessKey(ListCfg(DataPtr^),Inkey,X,Y,false);
      integer(SourcePtr^) := ListCfg(DataPtr^).ActiveNode;
   end;
end; { ListKeyHandler }

procedure ListRefreshField(FNP:FieldSettingsPtr);
{}
begin
   with FNP^ do
      if DataPtr <> nil then
      begin
         ListCfg(DataPtr^).ActiveNode := integer(SourcePtr^);
         StringLLPtr(ListCfg(DataPtr^).DataSource)^.ActiveNode := integer(SourcePtr^);
      end;
end; { ListRefreshField }

{$IFDEF FOFF}
   {$F-}
   {$UNDEF FOFF}
{$ENDIF}

function ListLastKey(FieldID:integer):word;
{}
var FNP: FieldNodePtr;
begin
   ListLastKey := 0;
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
      with FNP^.FieldInfo^ do
         if DataPtr <> nil then
            ListLastKey := ListCfg(DataPtr^).LastKey;
end; { ListLastKey }

procedure ListField(FieldID:integer; width,depth:byte; var SelectedItem:integer);
{}
var FNP: FieldNodePtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
      with FNP^.FieldInfo^ do
      begin
         SetFieldDefaults(FNP^.FieldInfo);
         X2 := X1 + pred(width);
         Y2 := Y1 + pred(depth);
         ProcesskeyHook := ListKeyHandler;
         SuspendHook := SuspendOK;
         DisplayHook := ListDisplay;
         DisposeHook := DisposeListMemory;
         RefreshFieldHook := ListRefreshField;    {change this}
         FieldStr    := '';
         FieldFmt    := '';
         FieldLen    := 0;
         FieldRules  := 0;
         OMisc       := ListFld;
         UsesCursors := true;
         SourcePtr := @SelectedItem;
      end;
end; { ListField }

                          {*********************}
                          {**  WrapListField  **}
                          {*********************}

{$IFOPT F-}
   {$DEFINE FOFF}
   {$F+}
{$ENDIF}

procedure WrapListDisplay(FSP:FieldSettingsPtr;Status:gStatus);
{}
begin
   WrapListRefresh(ListCfg(FSP^.DataPtr^),Status);
end; { WrapListDisplay }

function WrapListKeyHandler(InKey:word;X,Y:byte):gAction;
{}
begin
   WrapListKeyHandler := none;
   with ActiveForm^.ActiveFieldPtr^.FieldInfo^ do
      WrapListProcessKey(ListCfg(DataPtr^),Inkey,X,Y,false);
end; { WrapListKeyHandler }

{$IFDEF FOFF}
   {$F-}
   {$UNDEF FOFF}
{$ENDIF}

procedure WrapListField(FieldID:integer; Colwidth,ColCount,RowCount:byte;var ListDetails: ListCfg);
{}
var FNP: FieldNodePtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
      with FNP^.FieldInfo^ do
      begin
         SetFieldDefaults(FNP^.FieldInfo);
         X2 := X1 + ColWidth*ColCount;  {last column is for scroill bar}
         Y2 := Y1 + pred(RowCount);
         Listdetails.X1 := X1;
         Listdetails.Y1 := Y1;
         Listdetails.X2 := X2;
         Listdetails.Y2 := Y2;
         Listdetails.ColWidth := ColWidth;
         RecalcListDimensions(Listdetails);
         ProcesskeyHook := WrapListKeyHandler;
         SuspendHook := SuspendOK;
         DisplayHook := WrapListDisplay;
         DisposeHook := BasicDisposeHook;
         FieldStr    := '';
         FieldFmt    := '';
         FieldLen    := 0;
         FieldRules  := 0;
         OMisc       := ListFld;
         UsesCursors := true;
         DataPtr := @Listdetails;
      end;
end; { WrapListField }

                          {*********************}
                          {**  GridListField  **}
                          {*********************}
{$IFOPT F-}
   {$DEFINE FOFF}
   {$F+}
{$ENDIF}

procedure GridListDisplay(FSP:FieldSettingsPtr;Status:gStatus);
{}
begin
   GridRefresh(ListCfg(FSP^.DataPtr^),Status);
end; { GridListDisplay }

function GridListKeyHandler(InKey:word;X,Y:byte):gAction;
{}
begin
   GridListKeyHandler := none;
   with ActiveForm^.ActiveFieldPtr^.FieldInfo^ do
      GridProcessKey(ListCfg(DataPtr^),Inkey,X,Y,false);
end; { GridListKeyHandler }

{$IFDEF FOFF}
   {$F-}
   {$UNDEF FOFF}
{$ENDIF}

procedure GridListField(FieldID:integer; width,depth:byte;var ListDetails: ListCfg);
{}
var FNP: FieldNodePtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
      with FNP^.FieldInfo^ do
      begin
         SetFieldDefaults(FNP^.FieldInfo);
         X2 := pred(X1) + Width;
         Y2 := pred(Y1) + Depth;
         Listdetails.X1 := X1;
         Listdetails.Y1 := Y1;
         Listdetails.X2 := X2;
         Listdetails.Y2 := Y2;
         with Listdetails do
         begin
            if RowLock > 0 then
               TopNode := succ(RowLock);
            if ColumnLock > 0 then
               StartingCol := succ(ColumnLock);
         end;
         ProcesskeyHook := GridListKeyHandler;
         SuspendHook := SuspendOK;
         DisplayHook := GridListDisplay;
         DisposeHook := BasicDisposeHook;
         FieldStr    := '';
         FieldFmt    := '';
         FieldLen    := 0;
         FieldRules  := 0;
         OMisc       := ListFld;
         UsesCursors := true;
         DataPtr := @Listdetails;
      end;
end; { GridListField }

                           {********************}
                           {**  Scroll Field  **}
                           {********************}

procedure ScrollForceCase(FieldID:integer; FCase: gCase);
{}
var FNP: FieldNodePtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
      with FNP^.FieldInfo^ do
      begin
         if OMisc <> ScrollFld then
            IOSetError(1010);
         ScrollInfoPtr(DataPtrS)^.Forcecase := FCase;
     end;
end; { ScrollForceCase }

procedure ScrollRedisplay(FSP:FieldSettingsPtr;Status:gStatus);
{}
var TempStr:strscreen;
    P,A: byte;

   procedure WriteScrollIcons;
   {}
   begin
      with FSP^ do
      with IOVars.Form[IOVars.CurrentForm]^ do
      with ScrollInfoPtr(DataPtrS)^ do
      begin
         if (Status in [Activate,HiStatus]) and (StartChar > 1) then
            WriteAT(X1,Y1,Col[IOIcons2],IO2Vars.ScrollLeft)
         else
            WriteAT(X1,Y1,A,' ');
         if (Status in [Activate,HiStatus])
         and (length(FieldStr) - StartChar >= FieldLen) then
            WriteAT(X2,Y1,Col[IOIcons2],IO2Vars.ScrollRight)
         else
            WriteAT(X2,Y1,A,' ');
      end;
   end; { WriteScrollIcons }

begin
   with FSP^ do
   with IOVars.Form[IOVars.CurrentForm]^ do
   with ScrollInfoPtr(DataPtrS)^ do
   begin
      FieldStr := AdjCase(ForceCase,FieldStr);
      TempStr := TruncFormat(FieldStr,StartChar,FieldLen,IOVars.Whitespace);
      if Status in [Activate,HiStatus] then
      begin
         GotoXY(CursorX,Y1);
         A := Col[IOEditHi];
         if FirstCharPress
         and (length(FieldStr) <> 0)
         and IsRule(FieldRules,EraseDefault) then
         begin
            WriteScrollIcons;
            P := pos(IOVars.Whitespace,TempStr);
            if (P = 0) then
               WriteAT(succ(X1),Y1,Col[IOEditErase],TempStr)
            else
            begin
               WriteAT(succ(X1),Y1,Col[IOEditErase],copy(TempStr,1,pred(P)));
               WriteAT(X1+P,Y1,Col[IOEditHi],copy(TempStr,P,80));
            end;
            exit;
         end;
      end
      else if Active = FldOn then
         A := Col[IOEditNorm]
      else
         A := Col[IOEditOff];
      WriteAT(succ(X1),Y1,A,TempStr);
      WriteScrollIcons;
   end;
end; { ScrollRedisplay }

{$IFOPT F-}
   {$DEFINE FOFF}
   {$F+}
{$ENDIF}

procedure ScrollRefresh(FSP:FieldSettingsPtr);
{}
begin
   if (FSP <> nil) then
      with FSP^ do
      begin
         FieldStr := VarToStr(FSP);
         StrLocX       := 1;
         CursorX       := succ(X1);
         with ScrollInfoPtr(DataPtrS)^ do
            StartChar := 1;
      end;
end; { ScrollRefresh }

function ScrollSuspend:boolean;
{}
begin
   with ActiveForm^.ActiveFieldPtr^.FieldInfo^ do
      if (FieldStr = '') and not IsRule(FieldRules,AllowNull) then
      begin
         CannotBeEmptyMessage;
         ScrollSuspend := false
      end
      else
         ScrollSuspend := true;
end; { ScrollSuspend }

procedure ScrollUpdate(FSP:FieldSettingsPtr);
{}
begin
   if (FSP <> nil) then
      with FSP^ do
           SPtr^ := FieldStr;
end; { ScrollUpdate }

procedure ScrollDisplay(FSP:FieldSettingsPtr;Status:gStatus);
{}
begin
   case Status of
      Activate,
      HiStatus:begin
          CursorOn;
          ScrollRedisplay(FSP,Status);
      end;
      OffStatus,
      NormStatus: ScrollRedisplay(FSP,Status);
   end; {case}
end; { ScrollDisplay }

function ScrollKeyHandler(InKey:word;X,Y:byte):gAction;
{Input handler used by the lateral scrolling string field}
var FSP: FieldSettingsPtr;
    K: char;

   procedure CursorLeft;
   {}
   begin
      with FSP^ do
      with ScrollInfoPtr(DataPtrS)^ do
      if StrLocX > 1 then
      begin
         if StrLocX = StartChar then
         begin
            dec(StartChar);
            dec(StrLocX);
            ScrollRedisplay(FSP,HiStatus)
         end else
         begin
            dec(CursorX);
            dec(StrLocX);
         end;
      end;
   end; { CursorLeft }

   procedure CursorRight;
   {}
   begin
      with FSP^ do
      with ScrollInfoPtr(DataPtrS)^ do
         if (StrLocX <= length(FieldStr)) and (StrLocX <= MaxLen) then
         begin
            if StrLocX - StartChar = FieldLen then
            begin
               inc(StartChar);
               inc(StrLocX);
               ScrollRedisplay(FSP,HiStatus);
            end else
            begin
               inc(CursorX);
               inc(StrLocX);
            end;
         end;
   end; { CursorRight }

   procedure CursorHome;
   {}
   begin
      with FSP^ do
      with ScrollInfoPtr(DataPtrS)^ do
      begin
         StrLocX := 1;
         CursorX := succ(X1);
         if StartChar <> 1 then
         begin
            StartChar := 1;
            ScrollRedisplay(FSP,HiStatus);
         end;
      end;
   end; { CursorHome }

   procedure CursorEnd;
   {}
   begin
      with FSP^ do
      with ScrollInfoPtr(DataPtrS)^ do
         if (StrLocX <= length(FieldStr)) then
         begin
            StrLocX := succ(length(FieldStr));
            if (StrLocX - StartChar) > FieldLen then
            begin
               StartChar := StrLocX - FieldLen;
               CursorX := X2;
               ScrollRedisplay(FSP,HiStatus);
            end else
               CursorX := succ(X1) + StrLocX - StartChar;
         end;
   end; { CursorEnd }

   procedure EraseField;
   {}
   begin
      with FSP^ do
      with ScrollInfoPtr(DataPtrS)^ do
      begin
         CursorX := succ(X1);
         StrLocX := 1;
         FieldStr := '';
         ScrollRedisplay(FSP,HiStatus);
      end;
   end; { EraseField }

   procedure DeleteChar;
   {}
   begin
      with FSP^ do
         if StrLocX <= length(FieldStr) then
         begin
            delete(FieldStr,StrLocX,1);
            ScrollRedisplay(FSP,HiStatus);
         end;
   end; { DeleteChar }

   procedure Backspaced;
   {}
   begin
      with FSP^ do
         if StrLocX > 1 then
         begin
            CursorLeft;
            DeleteChar;
            ScrollRedisplay(FSP,HiStatus);
         end;
   end; { Backspaced }

   procedure MouseDown;
   {}
   var L,C,R:boolean;
       LeftX,RightX,
       StartCursX,NewCursX,X,Y,P: byte;
       TempStr:string;
       WaitTime: integer;

       procedure MouseScrollLeft;
       {}
       var OldStartChar: byte;
       begin
          with FSP^ do
          with ScrollInfoPtr(DataPtrS)^ do
          begin
             CursorX := succ(X1);         {move cursor to left-most character}
             StrLocX := StartChar;
             repeat
                MouseStatusWin(L,C,R,X,Y);
                if (X = X1) and (Y = Y1) and L and (StartChar > 1) then
                begin
                   OldStartChar := StartChar;
                   CursorLeft;
                   if (StartChar <> OldStartChar) then
                   begin
                      ScrollRedisplay(FSP,HiStatus);
                      if (ActiveForm^.WinNum <> 0) then
                         WinDrawTop;
                   end;
                end;
                DelayIt(L,(ActiveForm^.WinNum <> 0),WaitTime);
             until not L;
          end;
       end; { MouseScrollLeft }

       procedure MouseScrollRight;
       {}
       var OldStartChar: byte;
       begin
          with FSP^ do
          with ScrollInfoPtr(DataPtrS)^ do
          begin
             CursorX := pred(X2);               {move cursor to right-most character}
             StrLocX := CursorX - X1 - pred(StartChar);
             repeat
                MouseStatusWin(L,C,R,X,Y);
                if (X = X2) and (Y = Y1) and L and (length(FieldStr) - StartChar >= FieldLen) then
                begin
                   OldStartChar := StartChar;
                   CursorRight;
                   if (StartChar <> OldStartChar) then
                   begin
                      ScrollRedisplay(FSP,HiStatus);
                      if (ActiveForm^.WinNum <> 0) then
                         WinDrawTop;
                   end;
                end;
                DelayIt(L,(ActiveForm^.WinNum <> 0),WaitTime);
             until not L;
          end;
       end; { MouseScrollRight }

       procedure MouseMoveCursor;
       {}
       begin
          with FSP^ do
          with ScrollInfoPtr(DataPtrS)^ do
          begin
             StartCursX := 0;
             TempStr := TruncFormat(FieldStr,StartChar,FieldLen,IOVars.Whitespace);
             LeftX := succ(X1);
             P := pos(IOVars.WhiteSpace,TempStr);
             if P = 0 then
                RightX := pred(X2)
             else
                RightX := X1 + P;
             repeat
                MouseStatusWin(L,C,R,X,Y);
                if L and (Y = Y1) and (X >= X1) and (X <= X2) then
                begin
                   if (X >= LeftX) and (X <= RightX) then
                   begin
                      NewCursX := X;
                      if StartCursX = 0 then
                         StartCursX := NewCursX;
                      gotoxy(NewCursX,Y1);
                      if (FirstCharPress) then
                      begin  {clear the erase default setting}
                         FirstCharPress := false;
                         ScrollRedisplay(FSP,HiStatus);
                      end;
                      CursorX := NewCursX;
                   end;
                end;
             until not L;
             StrLocX := pred(CursorX - X1 + StartChar);
          end;
       end; { MouseMoveCursor }

   begin
      with FSP^ do
      with ScrollInfoPtr(DataPtrS)^ do
      begin
         WaitTime := KeyVars.InitScrollDelay;
         MouseStatusWin(L,C,R,X,Y);
         if (X = X1) and (StartChar > 1) then
            MouseScrollleft
         else if (X = X2) and (length(FieldStr) - StartChar >= FieldLen) then
            MouseScrollRight
         else if (X >= X1) and (X <= X2) then
            MouseMoveCursor;
     end;
   end; { MouseDown }

   procedure InsertCharacter;
   {}
   begin
      with FSP^ do
      with ScrollInfoPtr(DataPtrS)^ do
         if (length(FieldStr) < MaxLen) then
         begin
            insert(K,FieldStr,StrLocX);
            CursorRight;
         end else
            FieldFullmessage;
   end; { InsertCharacter }

   procedure OvertypeCharacter;
   {}
   begin
      with FSP^ do
      begin
         delete(FieldStr,StrLocX,1);
         insert(K,FieldStr,StrLocX);
         CursorRight;
      end;
   end; { OvertypeCharacter }

begin
   FSP := ActiveForm^.ActiveFieldPtr^.FieldInfo;
   ScrollKeyHandler := none;
   K := WordToChar(InKey);
   with ActiveForm^ do
      if  (FSP^.AllowChar <> [#0])
      and (not (K in FSP^.AllowChar)) then
      begin
         if K <> NoChar then
            Beep;
         exit;
      end;
   with FSP^ do
   with ScrollInfoPtr(DataPtrS)^ do
   case Inkey of
      32..255 : begin
         case ForceCase of
            Lower: K := GetUpCase(K);
            Upper: K := GetLoCase(K);
         end;
         if ( (AllowChar = [#0])
              or
              ((AllowChar <> [#0]) and (K in AllowChar))
            )
         and ( (DisAllowChar = [#0])
               or ((DisAllowChar <> [#0]) and ((K in DisAllowChar)= false))
             )  then
         begin
            if FirstCharPress then
            begin
               if IsRule(FieldRules,EraseDefault) then
                   EraseField;
               FirstCharPress := false;
            end;
            if ActiveForm^.InsertMode then
               InsertCharacter
            else
                OverTypeCharacter;
         end else
             Beep;
      end;
      339: DeleteChar;
      331: CursorLeft;
      333: CursorRight;
      338: with ActiveForm^ do
           begin
              InsertMode := not InsertMode;
              InsertProc(InsertMode);
           end;
      327: CursorHome;
      335: CursorEnd;
      8  : Backspaced;
      500: MouseDown;
      600..1000: ; {don't beep}
      else
         Beep;
  end; {case}
end; { ScrollKeyHandler }

procedure DisposeScrollMemory(FNP:FieldSettingsPtr);
{Disposes of heap memory allocated for scroll fields}
begin
   with FNP^ do
   if (DataPtrS <> nil) then
      freemem(DataPtrS,DataSize);
end; { DisposeScrollMemory }

{$IFDEF FOFF}
   {$F-}
   {$UNDEF FOFF}
{$ENDIF}

procedure ScrollField(FieldID:integer; var Strvar:string;FieldL,MaxL:byte);
{}
var FNP: FieldNodePtr;
begin
   FNP := FieldPtr(FieldID);
   if (FNP <> nil) then
      with FNP^.FieldInfo^ do
      begin
         SetFieldDefaults(FNP^.FieldInfo);
         SPtr          := @StrVar;
         FieldStr      := Sptr^;
         FieldLen      := FieldL - 2;
         FieldType     := IOString;
         StrLocX       := 1;
         CursorX       := succ(X1);
         X2 := X1 + pred(FieldL);
         ProcesskeyHook := ScrollKeyHandler;
         SuspendHook := ScrollSuspend;
         DisplayHook := ScrollDisplay;
         UpdateVarHook := ScrollUpdate;
         RefreshFieldHook := ScrollRefresh;
         DisposeHook := DisposeScrollMemory;
         OMisc       := ScrollFld;
         UsesCursors := false;
         dataSize := sizeof(ScrollInfo);
         getmem(DataPtrS,DataSize);
         with ScrollInfoPtr(DataPtrS)^ do
         begin
            Maxlen := MaxL;
            StartChar := 1;
            ForceCase := Leave;
         end;
      end;
end; { ScrollField }

                     {**********************************************}
                     {**  U N I T    I N I T I A L I Z A T I O N  **}
                     {**********************************************}
procedure IO2DefaultSettings;
{}
begin
   with IO2Vars do
   begin
      CheckOff := '[ ]';
      CheckOn := '[X]';
      RadioOff := '( )';
      RadioOn := '()';
      ScrollLeft := '';
      ScrollRight := '';
      ButtonLeft := ' ';
      ButtonRight := ' ';
   {$IFNDEF NOVGACHARS}
      FancyCheckOff := chr(208)+chr(209)+chr(183);
      FancyCheckOn := chr(208)+chr(210)+chr(183);
      FancyRadioOff := chr(211)+chr(212)+chr(184);
      FancyRadioOn := chr(211)+chr(213)+chr(184);
   {$ENDIF}
   end;
end; { IO2DefaultSettings }

procedure GoldIO2Init;
{}
begin
   IO2DefaultSettings;
end; {GoldIO2Init}

begin
   GoldIO2Init;
end.